home *** CD-ROM | disk | FTP | other *** search
/ CD ROM Paradise Collection 4 / CD ROM Paradise Collection 4 1995 Nov.iso / program / swagg_m.zip / GRAPHICS.SWG / 0070_Moving a Shape across CRT.pas < prev    next >
Pascal/Delphi Source File  |  1994-01-27  |  3KB  |  137 lines
  1. {
  2. From: BAS VAN GAALEN
  3. Subj: Sin-curver Sprites
  4. ---------------------------------------------------------------------------
  5.  
  6.  OB>> 1. Scrolling 256c fonts Fast and Smooth.
  7.  OB>> 2. Now to do it on top of graphics...
  8.  OB>> 3. 3D object engine - If someone can post me one or direct me
  9.  OB>> to build one.
  10.  OB>> 4. Shade Bobs/Whatever it called - Taking a shape and moving it
  11.  OB>> across the screen when it leaves trail.  Then, moving again
  12.  OB>> on the trail will couse a stronger color to appear. n' on...
  13.  OB>> 5. Moving floor that is NOT a couse of a palette rotetion.
  14.  OB>> 6. 2D Scale procedure.
  15.  OB>> 7. Centered Stars. And SMOOTH ones.
  16.  OB>> 8. Vector Balls
  17.  
  18. I don't want to give it all away, but I just made some Shaded-bobs (or
  19. whatever). It realy isn't difficult. It worked right away. Now YOU make a nicer
  20. sin-curve and palette. Here's some source:
  21.  
  22. { --- cut here --- }
  23.  
  24. {$G+}
  25.  
  26. program ShadingBobs;
  27. const
  28.   Gseg : word = $a000;
  29.   Sofs = 75; Samp = 75; Slen = 255;
  30.   SprPic : array[0..15,0..15] of byte = (
  31.     (0,0,0,0,0,0,1,1,1,1,0,0,0,0,0,0),
  32.     (0,0,0,0,1,1,1,1,1,1,1,1,0,0,0,0),
  33.     (0,0,0,1,1,1,1,1,1,1,1,1,1,0,0,0),
  34.     (0,0,1,1,1,1,1,2,2,1,1,1,1,1,0,0),
  35.     (0,1,1,1,1,1,2,2,2,2,1,1,1,1,1,0),
  36.     (0,1,1,1,1,2,2,3,3,2,2,1,1,1,1,0),
  37.     (1,1,1,1,2,2,3,3,3,3,2,2,1,1,1,1),
  38.     (1,1,1,1,2,2,3,4,4,3,2,2,1,1,1,1),
  39.     (1,1,1,1,2,2,3,3,3,3,2,2,1,1,1,1),
  40.     (0,1,1,1,1,2,2,3,3,2,2,1,1,1,1,0),
  41.     (0,1,1,1,1,1,2,2,2,2,1,1,1,1,1,0),
  42.     (0,0,1,1,1,1,1,2,2,1,1,1,1,1,0,0),
  43.     (0,0,1,1,1,1,1,1,1,1,1,1,1,1,0,0),
  44.     (0,0,0,1,1,1,1,1,1,1,1,1,1,0,0,0),
  45.     (0,0,0,0,1,1,1,1,1,1,1,1,0,0,0,0),
  46.     (0,0,0,0,0,0,1,1,1,1,0,0,0,0,0,0));
  47. type SinArray = array[0..Slen] of word;
  48. var Stab : SinArray;
  49.  
  50. procedure CalcSinus; var I : word; begin
  51.   for I := 0 to Slen do Stab[I] := round(sin(I*4*pi/Slen)*Samp)+Sofs; end;
  52.  
  53. procedure SetGraphics(Mode : word); assembler; asm
  54.   mov ax,Mode; int 10h end;
  55.  
  56. function keypressed : boolean; assembler; asm
  57.   mov ah,0bh; int 21h; and al,0feh; end;
  58.  
  59. procedure DrawSprite(X,Y : integer; W,H : byte; Sprite : pointer); assembler;
  60. asm
  61.   push ds
  62.   lds si,[Sprite]
  63.   mov es,Gseg
  64.   cld
  65.   mov ax,[Y]
  66.   shl ax,6
  67.   mov di,ax
  68.   shl ax,2
  69.   add di,ax
  70.   add di,[X]
  71.   mov bh,[H]
  72.   mov cx,320
  73.   sub cl,[W]
  74.   sbb ch,0
  75.  @L:
  76.   mov bl,[W]
  77.  @L2:
  78.   lodsb
  79.   or al,al
  80.   jz @S
  81.   mov dl,[es:di]
  82.   add dl,al
  83.   mov [es:di],dl
  84.  @S:
  85.   inc di
  86.   dec bl
  87.   jnz @L2
  88.   add di,cx
  89.   dec bh
  90.   jnz @L
  91.   pop ds
  92. end;
  93.  
  94. procedure Retrace; assembler; asm
  95.   mov dx,3dah;
  96.   @l1: in al,dx; test al,8; jnz @l1;
  97.   @l2: in al,dx; test al,8; jz @l2; end;
  98.  
  99. procedure Setpalette;
  100. var I : byte;
  101. begin
  102.   for I := 0 to 255 do begin
  103.     port[$3c8] := I;
  104.     port[$3c9] := I div 3;
  105.     port[$3c9] := I div 2;
  106.     port[$3c9] := I;
  107.   end;
  108. end;
  109.  
  110. procedure Bobs;
  111. var X,Y : integer; I,J : byte;
  112. begin
  113.   I := 0; J := 25;
  114.   repeat
  115.     X := 2*Stab[I]; Y := Stab[J];
  116.     inc(I); inc(J);
  117.     Retrace;
  118.     DrawSprite(X,Y,16,16,addr(SprPic));
  119.   until keypressed;
  120. end;
  121.  
  122. begin
  123.   CalcSinus;
  124.   SetGraphics($13);
  125.   SetPalette;
  126.   Bobs;
  127.   SetGraphics(3);
  128. end.
  129.  
  130. { DrawSprite procedure taken from Sean Palmer (again).
  131.   It contained some minor bugs: [X] was added to AX, should be DI, and
  132.   jz @S was jnz @S, so the sprite wasn't drawn. Now it is...
  133.   And of course it was changed to INCREASE the video-mem, not to poke it.
  134.  
  135.   If you get rid of the Retrace it goes a LOT faster. }
  136.  
  137.